home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pcl4b42 / xypacket.bas < prev    next >
BASIC Source File  |  1995-05-09  |  8KB  |  311 lines
  1. ' -- XYPACKET.BAS --
  2. '
  3. ' This program is donated to the Public
  4. ' Domain by MarshallSoft Computing, Inc.
  5. ' It is provided as an example of the use
  6. ' of the Personal Communications Library.
  7. '
  8. ' LONG (4-byte) variables are used for checksums
  9. ' because Visual Basic doesn't support unsigned
  10. ' integers. The string Buffer$ is used because
  11. '
  12. '
  13.  
  14. DefInt A-Z
  15.  
  16. '$INCLUDE: 'DEFINES.BI'
  17. '$INCLUDE: 'TIMING.BI'
  18. '$INCLUDE: 'PCL4B.BI'
  19. '$INCLUDE: 'TERM_IO.BI'
  20. '$INCLUDE: 'CRC.BI'
  21. '$INCLUDE: 'XYPACKET.BI'
  22.  
  23. DECLARE FUNCTION HIGH (BYVAL Word)
  24.  
  25. Const xyBufferSize = 1024
  26. Const MAXTRY = 3, LIMIT = 20
  27. Const SOH = 1, STX = 2, EOT = 4
  28. Const ACK = 6, NAK = 21, CAN = 24
  29. CONST FALSE = 0, TRUE = NOT FALSE
  30.  
  31.  
  32. Function RxPacket (ByVal Port, ByVal PacketNbr, Buffer$, PacketSize, ByVal NCGbyte, EOTflag)
  33.   'Port      : Port # [0..3)
  34.   'PacketNbr : Packet # [0,1,2,...)
  35.   'PacketSize: Packet size [128,1024) {returned}
  36.   'NCGbyte   : NAK, "C", or "G"
  37.   'EOTflag   : EOT was received       {returned}
  38.   '
  39.   PacketNbr = PacketNbr And 255
  40.   For Attempt = 1 To MAXTRY
  41.     'wait FOR SOH / STX
  42.     Code = SioGetc(Port, LONG_WAIT * ONE_SECOND)
  43.     If Code = -1 Then
  44.       Print "Timed out waiting FOR sender"
  45.       RxPacket = False
  46.       Exit Function
  47.     End If
  48.     Select Case Code
  49.       Case SOH
  50.         '128 byte buffer incoming
  51.         PacketType = SOH
  52.         PacketSize = 128
  53.       Case STX
  54.         '1024 byte buffer incoming
  55.         PacketType = STX
  56.         PacketSize = 1024
  57.       Case EOT
  58.         'all packets have been sent
  59.         Code = SioPutc(Port, ACK)
  60.         EOTflag = True
  61.         RxPacket = True
  62.         Exit Function
  63.       Case CAN
  64.         'sender has canceled !
  65.         Print "Canceled by remote"
  66.         RxPacket = False
  67.       Case Else
  68.         'error !
  69.         Print "Expecting SOH/STX/EOT/CAN not "; Code
  70.         RxPacket = False
  71.     End Select
  72.     'receive packet #
  73.     Code = SioGetc(Port, ONE_SECOND)
  74.     If Code = -1 Then
  75.       Print "Timed out waiting for packet #"
  76.       Exit Function
  77.     End If
  78.     RxPacketNbr = Code And 255
  79.     'receive 1's complement
  80.     Code = SioGetc(Port, ONE_SECOND)
  81.     If Code = -1 Then
  82.       Print "Timed out waiting for complement of packet #"
  83.       RxPacket = False
  84.       Exit Function
  85.     End If
  86.     RxPacketNbrC = Code And 255
  87.     'receive data
  88.     CheckSum& = 0
  89.     Buffer$ = ""
  90.     Buffer$ = String$(PacketSize, 0)
  91.     For I = 1 To PacketSize
  92.       Code = SioGetc(Port, ONE_SECOND)
  93.       If Code = -1 Then
  94.         Print "Timed out waiting for data for packet #"
  95.         RxPacket = False
  96.         Exit Function
  97.       End If
  98.       Mid$(Buffer$, I, 1) = Chr$(Code)
  99.       'compute CRC or checksum
  100.       If NCGbyte <> NAK Then
  101.         CheckSum& = UpdateCRC&(CheckSum&, Code)
  102.       Else
  103.         CheckSum& = (CheckSum& + Code) And 255
  104.       End If
  105.     Next I
  106.     'receive CRC/checksum
  107.     If NCGbyte <> NAK Then
  108.       'receive 2 byte CRC
  109.       Code = SioGetc(Port, ONE_SECOND)
  110.       If Code = -1 Then
  111.         Print "Timed out waiting for 1st CRC byte"
  112.         Exit Function
  113.       End If
  114.       RxCheckSum1& = Code And 255
  115.       Code = SioGetc(Port, ONE_SECOND)
  116.       If Code = -1 Then
  117.         Print "Timed out waiting for 2nd CRC byte"
  118.         RxPacket = False
  119.         Exit Function
  120.       End If
  121.       RxCheckSum2& = Code And 255
  122.       RxCheckSum& = (256 * RxCheckSum1&) Or RxCheckSum2&
  123.     Else
  124.       'receive one byte checksum
  125.       Code = SioGetc(Port, ONE_SECOND)
  126.       If Code = -1 Then
  127.         Print "Timed out waiting for checksum"
  128.         RxPacket = False
  129.         Exit Function
  130.       End If
  131.       RxCheckSum& = Code And 255
  132.     End If
  133.     'don't send ACK IF "G"
  134.     If NCGbyte = Asc("G") Then
  135.       RxPacket = True
  136.       Exit Function
  137.     End If
  138.     'packet # and checksum OK ?
  139.     If (RxCheckSum& = CheckSum&) And (RxPacketNbr = PacketNbr) Then
  140.       'ACK the packet
  141.       Code = SioPutc(Port, ACK)
  142.       RxPacket = True
  143.       Exit Function
  144.     End If
  145.     'bad packet
  146.     If RxCheckSum& = CheckSum& Then
  147.       Print "Bad Packet. Received "; RxPacketNbr; ", expected "; PacketNbr
  148.     Else
  149.       Print "Bad Checksum. Received "; RxCheckSum&; ", expected "; CheckSum&
  150.     End If
  151.     Code = SioPutc(Port, NAK)
  152.   Next Attempt
  153.   'can't receive packet
  154.   Print "RX packet timeout"
  155.   RxPacket = False
  156. End Function
  157.  
  158. Function RxStartup (ByVal Port, ByVal NCGbyte)
  159.   'clear Rx buffer
  160.   Code = SioRxFlush(Port)
  161.   'Send NAKs or "C"s
  162.   For I = 1 To LIMIT
  163.     AnyKey$ = INKEY$
  164.     If AnyKey$ <> "" Then
  165.       Print "Canceled by user"
  166.       RxStartup = False
  167.       Exit Function
  168.     End If
  169.     'stop attempting CRC after 1st 4 tries
  170.     If (NCGbyte <> NAK) And (I = 5) Then NCGbyte = NAK
  171.     'tell sender that I am ready to receive
  172.     Code = SioPutc(Port, NCGbyte)
  173.     Byte = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
  174.     If Byte <> -1 Then
  175.       'no error -- must be incoming byte -- push byte back onto queue !
  176.       Code = SioUnGetc(Port, Byte)
  177.       RxStartup = True
  178.       Exit Function
  179.     End If
  180.   Next I
  181.   'no response
  182.   Print "No response from sender"
  183.   RxStartup = False
  184. End Function
  185.  
  186. Function TxEOT (ByVal Port)
  187.   For I = 0 To 10
  188.     Code = SioPutc(Port, EOT)
  189.     'await response
  190.     Code = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
  191.     If Code = ACK Then
  192.       TxEOT = True
  193.       Exit Function
  194.     End If
  195.   Next I
  196.   TxEOT = False
  197.   End Function
  198.  
  199. Function TxPacket (ByVal Port, ByVal PacketNbr, Buffer$, ByVal PacketSize, ByVal NCGbyte)
  200.   'Port      : Port # [0..3)
  201.   'PacketNbr : Packet # [0,1,2,...)
  202.   'PacketSize: Packet size [128,1024)
  203.   'NCGbyte   : NAK, "C", or "G"
  204.   '
  205.   'better be 128 or 1024 packet length
  206.  
  207. '''PRINT "TxP: Port=";Port;"Packet#=";PacketNbr;"LEN=";LEN(Buffer$);"PacketSize=";PacketSize;",NCGbyte=";CHR$(NCGbyte)
  208.  
  209.   If PacketSize = 1024 Then
  210.     PacketType = STX
  211.   Else
  212.     PacketType = SOH
  213.   End If
  214.   PacketNbr = PacketNbr And 255
  215.   'make up to MAXTRY attempts to send this packet
  216.   For Attempt = 1 To MAXTRY
  217.     'send SOH/STX
  218.     Code = SioPutc(Port, PacketType)
  219.     'send packet #
  220.     Code = SioPutc(Port, PacketNbr)
  221.     'send 1's complement of packet
  222.     Code = SioPutc(Port, 255 - PacketNbr)
  223.     'send data
  224.     CheckSum& = 0
  225.     For I = 1 To PacketSize
  226.       Byte = Asc(Mid$(Buffer$, I, 1))
  227.       Code = SioPutc(Port, Byte)
  228.       'update checksum
  229.       If NCGbyte <> NAK Then
  230.         CheckSum& = UpdateCRC&(CheckSum&, Byte)
  231.       Else
  232.         CheckSum& = CheckSum& + Byte
  233.       End If
  234.     Next I
  235.     'send checksum
  236.     If NCGbyte <> NAK Then
  237.       'send 2 byte CRC
  238.       CS = (CheckSum& \ 256)
  239.       Code = SioPutc(Port, CS)
  240.       CS = (CheckSum& And 255)
  241.       Code = SioPutc(Port, CS)
  242.     Else
  243.       'send one byte checksum
  244.       CS = CheckSum&
  245.       Code = SioPutc(Port, CS)
  246.     End If
  247.     'don't wait for ACK if "G"
  248.     If NCGbyte = Asc("G") Then
  249.       If PacketNbr = 0 Then Code = SioDelay(SHORT_WAIT * ONE_SECOND / 2)
  250.       TxPacket = True
  251.       Exit Function
  252.     End If
  253.     'wait for receivers ACK
  254.     Code = SioGetc(Port, LONG_WAIT * ONE_SECOND)
  255.     If Code = CAN Then
  256.       Print "Canceled by remote"
  257.       TxPacket = False
  258.       Exit Function
  259.     End If
  260.     If Code = ACK Then
  261.       TxPacket = True
  262.       Exit Function
  263.     End If
  264.     If Code <> NAK Then
  265.       Print "Out of sync. Expect ACK or NAK, not"; Code
  266.       TxPacket = False
  267.       Exit Function
  268.     End If
  269.   Next Attempt
  270.   'can't send packet !
  271.   Print 'Packet timeout for port ';Port
  272.   TxPacket = False
  273. End Function
  274.  
  275. Function TxStartup (ByVal Port, NCGbyte)
  276.   'clear Rx buffer
  277.   Code = SioRxFlush(Port)
  278.   'wait for receivers start up NAK or "C"
  279.   For I = 1 To LIMIT
  280.     AnyKey$ = INKEY$
  281.     If AnyKey$ <> "" Then
  282.       Print "Aborted by user"
  283.       TxStartup = False
  284.       Exit Function
  285.     End If
  286.     Code = SioGetc(Port, SHORT_WAIT * ONE_SECOND)
  287.     If Code <> -1 Then
  288.       'received a byte
  289.       If Code = NAK Then
  290.         NCGbyte = NAK
  291.         TxStartup = True
  292.         Exit Function
  293.       End If
  294.       If Code = Asc("C") Then
  295.         NCGbyte = Asc("C")
  296.         TxStartup = True
  297.